home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir30 / springs.zip / SPRINGSQ.LSP < prev   
Lisp/Scheme  |  1994-03-08  |  4KB  |  110 lines
  1. (defun C:SQ ()
  2.      (command "cmdecho" 0) 
  3.      (setvar "osmode" 0)
  4.      (setvar "lunits" 2)
  5.      (defun dtr(A) (* PI (/ A 180.0)))
  6.      (defun tana(A) (/ (sin A) (cos A)))
  7.      (setq P0 (getpoint"\nLocate Start  "))
  8.      (princ "\nOutside Diameter <")
  9.      (princ OD*)(princ "> ")
  10.      (setq OD (getdist))(if (= OD NIL)
  11.      (setq OD OD*)(setq OD* OD))
  12.      (princ "\nWire Diameter <")
  13.      (princ WD*)(princ "> ")
  14.      (setq WD (getdist))(if (= WD NIL)
  15.      (setq WD WD*)(setq WD* WD))
  16.      (princ "\nPitch <")
  17.      (princ PTCH*)(princ "> ")
  18.      (setq PTCH (getdist))(if (= PTCH NIL)
  19.      (setq PTCH PTCH*)(setq PTCH* PTCH))
  20.      (princ "\nNumber of Turns <")
  21.      (princ N1*)(princ "> ")
  22.      (setq N1 (getreal))(if (= N1 NIL)
  23.      (setq N1 N1*)(setq N1* N1))
  24.      (setq WO2 (/ WD 2.0))
  25.      (setq MD (- OD WD))
  26.      (setq PTCHO2 (/ PTCH 2.0))
  27.      (setq Q1 (/ PTCHO2 (- OD WD)))
  28.      (setq A (atan Q1))
  29.      (setq A1 (+ PI A))
  30.      (setq A2 (- PI A))
  31.      (setq TWOPI (+ PI PI))
  32.      (setq PI3O2 (/ (* 3.0 PI) 2.0))
  33.      (setq PIO2 (/ PI 2.0))
  34.      (setq A3 (+ PIO2 A))
  35.      (setq A4 (- PIO2 A))
  36.      (setq PC1 (polar P0 PIO2 WO2))
  37.      (setq MA (- TWOPI A))
  38.      ;(setvar "blipmode" 0)
  39.      (setq N (- N1 2.0))
  40.      (setq TEST 0)
  41.      (while (<= TEST N)
  42.           (setq P1 (polar PC1 MA WO2))
  43.           (setq P2 (polar PC1 A2 WO2))
  44.           (setq PC2T (polar PC1 PIO2 MD))
  45.           (setq TANNA (tana A))
  46.           (setq PC2 (polar PC2T 0 (* MD TANNA)))
  47.           (setq DIST (* MD (tana A)))
  48.           (setq P4 (polar PC2 MA WO2))
  49.           (setq P3 (polar PC2 A2 WO2))
  50.           (setq PC3 (polar PC1 0 PTCH))
  51.           (setq P5 (polar PC3 A1 WO2))
  52.           (setq P6 (polar PC3 MA WO2))
  53.           (setq P7 (polar PC2 A WO2))
  54.           (setq DIST2 (/ WO2 (sin A)))
  55.           (setq P8 (polar PC3 PIO2 DIST2))
  56.           (setq MPIO2 (* 1.5 PI))
  57.           (setq P9 (polar PC2 MPIO2 DIST2))
  58.         (command "pline" P4 "W" 0 0 P1 "A" P2 "L" P3 "A" P4 "")
  59.           (command "pline" P9 P5 "A" P6 "")
  60.           (command "pline" P8 P7 "")
  61.           (setq PC1 (polar PC1 0 PTCH))
  62.           (setq TEST (+ TEST 1.0))
  63.      );end loop
  64.      (setq P1 (polar PC1 MA WO2))
  65.      (setq P2 (polar PC1 A2 WO2))
  66.      (setq PC2T (polar PC1 PIO2 MD))
  67.      (setq TANNA (tana A))
  68.      (setq PC2 (polar PC2T 0 (* MD TANNA)))
  69.      (setq DIST (* MD (TANA A)))
  70.      (setq P4 (polar PC2 MA WO2))
  71.      (setq P3 (polar PC2 A2 WO2))
  72.      (command "pline" P4 "W" 0 0 P1 "A" P2 "L" P3 "A" P4 "")
  73.      (setq AE1 (angle P1 P4))
  74.      (setq DB (distance P1 P4))
  75.      (setq LE (+ (/ WD 2.0)(* 0.125 WD)))
  76.      (setq P0L (polar P0 PI LE))
  77.      (setq P1 (polar P0L PIO2 (+ WD OD)))
  78.      (setq BACK (* 0.85 WD))
  79.      (setq P3 (polar P1 0 BACK))
  80.      (setq AE2 (angle P0L P3))
  81.      (setq SAE2 (abs (sin AE2)))
  82.      (setq LDE (/ OD SAE2))
  83.      (setq TANAE2 (TANA AE2))
  84.      (setq E (* (/ WO2 TANAE2)))
  85.      (setq LD (- LDE (+ E WO2)))
  86.      (setq P5 (polar P0L AE2 LD))
  87.      (setq P6 (polar P5 A2 WD))
  88.      (setq PBOX (getvar "pickbox"))
  89.      (setvar "pickbox" 1)
  90.      (command "pline" P0L P1 "")
  91.      (command "pline" P0L P5 "A" P6 "")
  92.      (command "trim" P1 P6 "" P6 P1 "")
  93.      (setq PR1 (polar P4 A2 WO2))
  94.      (setq PR2 (polar PR1 A4 WO2))
  95.      (setq P0R (polar PR2 0 LE))
  96.      (setq P1 (polar P0R PI3O2 (+ WD OD)))
  97.      (setq AE2 (+ AE2 PI))
  98.      (setq P5 (polar P0R AE2 LD))
  99.      (setq A2 (+ A2 PI))
  100.      (setq P6 (polar P5 A2 WD))
  101.      (command "pline" P0R P1 "")
  102.      (command "pline" P0R P5 "A" P6 "")
  103.      (command "TRIM" P1 P6 "" P6 P1 "")
  104.      (setvar "pickbox" PBOX)
  105.      (setvar "osmode" 1)
  106.      (command "cmdecho" 1)
  107.      ;(setvar "blipmode" 1)
  108.      (princ)
  109. ); end springsq.lsp
  110.